home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / incr-old.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  2.8 KB  |  90 lines  |  [TEXT/ALFA]
  1. # Commands covered:  incr
  2. #
  3. # This file contains the original set of tests for Tcl's incr command.
  4. # Since the incr command is now compiled, a new set of tests covering
  5. # the new implementation is in the file "incr.test". Sourcing this file
  6. # into Tcl runs the tests and generates output for errors.
  7. # No output means no errors were found.
  8. #
  9. # Copyright (c) 1991-1993 The Regents of the University of California.
  10. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15. # SCCS: @(#) incr-old.test 1.11 96/11/19 16:56:23
  16.  
  17. if {[string compare test [info procs test]] == 1} then {source defs}
  18.  
  19. catch {unset x}
  20.  
  21. test incr-old-1.1 {basic incr operation} {
  22.     set x 23
  23.     list [incr x] $x
  24. } {24 24}
  25. test incr-old-1.2 {basic incr operation} {
  26.     set x 106
  27.     list [incr x -5] $x
  28. } {101 101}
  29. test incr-old-1.3 {basic incr operation} {
  30.     set x "  -106"
  31.     list [incr x 1] $x
  32. } {-105 -105}
  33. test incr-old-1.3 {basic incr operation} {
  34.     set x "  +106"
  35.     list [incr x 1] $x
  36. } {107 107}
  37.  
  38. test incr-old-2.1 {incr errors} {
  39.     list [catch incr msg] $msg
  40. } {1 {wrong # args: should be "incr varName ?increment?"}}
  41. test incr-old-2.2 {incr errors} {
  42.     list [catch {incr a b c} msg] $msg
  43. } {1 {wrong # args: should be "incr varName ?increment?"}}
  44. test incr-old-2.3 {incr errors} {
  45.     catch {unset x}
  46.     list [catch {incr x} msg] $msg $errorInfo
  47. } {1 {can't read "x": no such variable} {can't read "x": no such variable
  48.     (reading value of variable to increment)
  49.     invoked from within
  50. "incr x"}}
  51. test incr-old-2.4 {incr errors} {
  52.     set x abc
  53.     list [catch {incr x} msg] $msg $errorInfo
  54. } {1 {expected integer but got "abc"} {expected integer but got "abc"
  55.     while executing
  56. "incr x"}}
  57. test incr-old-2.5 {incr errors} {
  58.     set x 123
  59.     list [catch {incr x 1a} msg] $msg $errorInfo
  60. } {1 {expected integer but got "1a"} {expected integer but got "1a"
  61.     while executing
  62. "incr x 1a"}}
  63. test incr-old-2.6 {incr errors} {
  64.     proc readonly args {error "variable is read-only"}
  65.     set x 123
  66.     trace var x w readonly
  67.     list [catch {incr x 1} msg] $msg $errorInfo
  68. } {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
  69.     while executing
  70. "incr x 1"}}
  71. catch {unset x}
  72. test incr-old-2.7 {incr errors} {
  73.     set x -
  74.     list [catch {incr x 1} msg] $msg
  75. } {1 {expected integer but got "-"}}
  76. test incr-old-2.8 {incr errors} {
  77.     set x {  -  }
  78.     list [catch {incr x 1} msg] $msg
  79. } {1 {expected integer but got "  -  "}}
  80. test incr-old-2.9 {incr errors} {
  81.     set x +
  82.     list [catch {incr x 1} msg] $msg
  83. } {1 {expected integer but got "+"}}
  84. test incr-old-2.10 {incr errors} {
  85.     set x {20 x}
  86.     list [catch {incr x 1} msg] $msg
  87. } {1 {expected integer but got "20 x"}}
  88.  
  89. concat {}
  90.